home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Developer Helper 1: Phil & Dave's Excellent CD
/
Excellent CD HFS.raw
/
Utilities
/
Apple File Exchange
/
AppleFile Exchange Translator
/
ExampleTrans
/
Example.p
< prev
next >
Wrap
Text File
|
1989-04-13
|
49KB
|
1,333 lines
unit TransExample;
(*
*_____________________________________________________________________
*
* File: Example.p
*
* Copyright 1986,1987 by Apple Computer, Inc. All Rights Reserved.
*_____________________________________________________________________
*
* Example translator between Macintosh, ProDOS, and MS-DOS.
*
* Written by Karl B. Young
*
*_____________________________________________________________________
*
* Revision History
*
* 16-Jul-87 1.0A1 New today
*_____________________________________________________________________
*
*
*_____________________________________________________________________
*)
{ This translator opens up the resource fork of a Macintosh file and copies *
* all resources of the type STR# to a text file on any of the file systems. *
* If the translation is Mac to Mac a dialog box is available to set the *
* creator type of the text file (to open it just double click on it ). *
* Note that this dialog box is only available when the translator is in the *
* Mac to Mac menu, in the other menus it will not appear since Mac creator *
* types have no meaning in the other file systems. Also notice how this *
* translator protects itself from being loaded into menus in which it has no*
* usefulness. *}
INTERFACE
USES
{$LOAD MacLoad.L} MemTypes,QuickDraw,osIntf,toolIntf,packIntf,macPrint,script,
{$LOAD } AFETrans;
{ AFETrans contains all of the standard AFE data structure definitions }
{ This is the function through which AFE communicates with the translator }
function TranStr(Message : integer; VAR TranslateData : Handle;
Param : longint; Self : handle) : longint;
IMPLEMENTATION
{$R-}
CONST
{************************************************************************
* *
* constants for strings (for error messages) *
* the order of these strings is the same as in Example.r *
* *
***********************************************************************}
str_error = 1; { "An error occurred while " }
str_creating = 2; { "creating the destination file: " }
str_opensrc = 3; { "opening the source file: " }
str_opendst = 4; { "opening the destination file: " }
str_getfinfo = 5; { "getting information about the file: " }
str_setfinfo = 6; { "setting the file type of the destination file: " }
str_reading = 7; { "reading in the source file: " }
str_writing = 8; { "writing out the destination file: " }
str_copying = 9; { "Copying STR# resources…" }
str_initing = 10; { "initializing the translator " }
str_period = 11; { "." }
str_cant = 12; { "It cannot translate from " }
str_to = 13; { " to " }
str_delsrc = 14; { "deleting the original file (your translated data is in the file $$$AFE-TEMP$$$): " }
str_rendst = 15; { "renaming the destination file (your translated data is in the file $$$AFE-TEMP$$$): "}
str_numstrings = 16; { "Number of STR# resources in this file: " }
str_stringRes = 17; { "String Resource number " }
{************************************************************************
* *
* constants for dialog box *
* these are the item numbers for the objects in the options dialog box *
* *
***********************************************************************}
d_OK = 1;
d_Cancel = 2;
d_text = 3;
d_MWradio = 4;
d_MSWradio = 5;
d_MPWradio = 6;
d_MDSradio = 7;
d_otherRadio = 8;
d_MWicon = 9;
d_MSWicon = 10;
d_MPWicon = 11;
d_MDSicon = 12;
d_otherText = 13;
{************************************************************************
* *
* Miscellaneous Constants *
* *
***********************************************************************}
tMCMC = 1; { Mac to Mac translation }
tMCPD = 2; { Mac to ProDOS translation }
tMCMS = 3; { Mac to MS-DOS translation }
{************************************************
* The following are offsets from the MacWrite *
* button in the options dialog box *
************************************************}
tMacWrite = 0; { MacWrite }
tMSWord = 1; { Microsoft Word }
tMPW = 2; { MPW }
tMDS = 3; { MDS 68000 }
tother = 4; { other }
{************************************************
* The following are creator names for the apps *
* in the options dialog box *
************************************************}
fMacWrite = 'MACA'; { MacWrite }
fMSWord = 'MWRD'; { Microsoft Word }
fMPW = 'MPS '; { MPW }
fMDS = 'EDIT'; { MDS 68000 }
fromFS = 0; { denotes the source file system }
toFS = 1; { denotes the destination file system }
TYPE
{This data type is used to hold the File system nicknames, MC,MS,PD. }
halfResType = packed array[1..2] of char;
{*************** Global Variables record **************}
StatusRec = RECORD
mystatus : longint; { keeps the status bits for the translator,
see discussion about TranData in the manual }
myID : integer; { ID number of the STR# resource containing
error strings }
myfref : integer; { The file reference number for my resource file }
trankind : integer; { The type of translation occurring, eg Mac to Mac}
ftype : OSType; { The creator name for the destination file }
fkind : integer; { the offset from the MacWrite dialog button }
frHandle : Handle; { handle to the source file system resource }
toHandle : Handle; { handle to the destination file system }
srcsize : longint; { byte size of the source file }
end;
StatPtr = ^StatusRec;
StatHndl = ^StatPtr;
{ Listing of all the functions in this unit }
Function Activate(statRec : statHndl; trnPB : trnPtr) : longint; Forward;
Function CopyFile(srcref,dstref : integer; statRec : statHndl; trnPB : trnPtr) : OSErr; Forward;
Function DoAppear(trnpb : trnptr; statRec : statHndl) : longint; Forward;
Function DoFileConvert(statRec : statHndl; trnPB : trnPtr) : longint; Forward;
Function DoFinish(VAR translateData : handle) : OSErr; Forward;
Function DoInit(VAR translateData,self : handle; trnpb : trnPtr) : longint; Forward;
Function DoName(statRec : statHndl; trnPB : trnPtr) : longint; Forward;
Function FileIO(ff,fs : integer; pb : HParmBlkPtr; statrec : StatHndl; trnPB : trnPtr) : OSErr; Forward;
Function FileOp(ff,fs : integer; pb : HParmBlkPtr; statrec : StatHndl; trnPB : trnPtr) : OSErr; Forward;
Function GetStrSize(fref : integer) : longint; Forward;
Function RecogFile(statRec : statHndl; trnPB : trnPtr) : longint; Forward;
Procedure ReportErr(err,doing : integer; statRec : statHndl; trnPB : trnPtr); Forward;
{*************************** Activate **************************************
* Called when translator receives a trn_Activate.
* ACTIVATE indicates that the user wishes to check this menu item. The *
* routine does whatever it wants (usually just setting the appropriate bit *
* in the flags, but it could be as complicated as a dialog box prompting *
* the user for options), and then returns the new status flag as the *
* function result. In this case Activate only puts up a dialog box if it is*
* being activated in the Mac to Mac menu; otherwise it just updates the *
* active bit in the status variable. *
* Notice how the dialog box is only activated for the Mac to Mac trans- *
* lation. For the other translation the we just set the active bit. *
***************************************************************************}
Function Activate(statRec : statHndl; trnPB : trnPtr) : longint;
var
user_ptr : dialogPtr;
cHndl : Controlhandle;
itype : integer; { type of item in the dialog box,see Inside Mac
vol I for details}
iHndl : handle; { a handle to an item }
irect : rect; { the display rectangle for the item }
i : integer;
str : str255;
item : integer;
curfkind : integer; { the current destination file type }
oldres : integer;
begin
{ if the translation is to prodos or msdos }
if statrec^^.tranKind > tMCMC
then statRec^^.mystatus := bor(trnActive,statRec^^.mystatus)
else if statrec^^.tranKind = tMCMC then begin
{ if the translation is Mac to Mac than get the option dialog box }
oldres := curResFile; { in case another resource file is being used }
useResFile(statRec^^.myFref);
user_ptr := getNewDialog(statRec^^.myID,nil,POINTER(-1));
useResFile(oldres); { restore the old res file }
{ set up the file type }
str := ' ';
{ check that the file type only consists of printable ascii characters }
for i := 1 to 4 do begin
if statRec^^.ftype[i] in [' '..'~']
then str[i] := statRec^^.ftype[i];
end;
getDItem(user_ptr,d_otherText,itype,iHndl,iRect);
setIText(iHndl,str);
{ set up the radio button }
{ get the previously selected file type, this is an offset from MacWrite}
curfkind := statrec^^.fkind;
{ get a handle to that item }
getDItem(user_ptr,d_MWradio+curfkind,itype,iHndl,iRect);
cHndl := POINTER(iHndl);
{ turn the button to that item on }
SetCtlValue(cHndl,1);
{ display the dialog box on the screen }
showWindow(user_ptr);
repeat
{ wait for a click in the dialog box }
modalDialog(NIL,item);
{ if click anywhere except OK or Cancel }
if item in [d_MWradio..d_otherText] then begin
{ if clicked on document icon calculate to which radio button }
{ it belongs. }
if item >= d_MWicon then item := d_MWradio + (item - d_MWicon);
{ if the new choice is not the same as the old choice }
if curfkind <> (item - d_MWradio) then begin
{ get a handle to the old item }
getDItem(user_ptr,d_MWradio+curfkind,itype,iHndl,iRect);
cHndl := POINTER(iHndl);
{ turn its radio button off }
SetCtlValue(cHndl,0);
{ get a handle to the new item }
getDItem(user_ptr,item,itype,iHndl,iRect);
cHndl := POINTER(iHndl);
{ turn its radio button on }
SetCtlValue(cHndl,1);
{ calculate the new offset from MacWrite }
curfkind := item - d_MWradio;
{ if the Other radio button is not highlighted then put }
{ the apporiate creator type in the text box }
if curfkind < tother then begin
case curfKind of
tMacWrite : str := fMacWrite;
tMSWord : str := fMSWord;
tMPW : str := fMPW;
tMDS : str := fMDS;
end;
getDItem(user_ptr,d_otherText,itype,iHndl,iRect);
SetIText(iHndl,str);
end;
end;
end;
until item in [d_OK,d_Cancel];
if item = d_OK then begin
{ save the destination file type in the Global variable }
statrec^^.fkind := curfKind;
getDItem(user_ptr,d_otherText,itype,iHndl,iRect);
GetIText(iHndl,str);
{ Make sure that the file type is four characters long }
statrec^^.ftype := ' ';
{ Take only the first four characters of the file type }
for i := 1 to 4 do begin
if length(str) >= i
then statrec^^.ftype[i] := str[i];
end;
{ Set the Active bit in the status variable }
statRec^^.myStatus := bor(statRec^^.myStatus,trnActive);
end;
DisposDialog(user_ptr);
end;
{ Return the current translator status. }
Activate := statRec^^.myStatus;
end; { Activate }
{* This is the function that actually does the translation of the STR# re- *
* source to a text file.
INPUT : srcref,dstref - file reference numbers for the source and destination
file.
datasize - the size of the source file
statRec - the Global variable record.
RESULT: The sucess or failure of the translation.
USED by : DoFileConvert
* Notice its use of tprocs to transliterate between the various character
* sets used by the different file systems. Also notice that whenever tprocs
* are called we make sure it is loaded in memory by using LoadResource, just
* because we have a handle to it does not mean it resides currently in
* memory because it is a purgeable resource.
*}
Function CopyFile(srcref,dstref : integer; statRec : statHndl; trnPB : trnPtr) : OSErr;
var
oldres : integer;
numstr,numentries : integer;
s,n : integer;
hstr : handle;
numptr : ^integer;
str : str255;
theID : integer;
theType : ResType;
theName : str255;
datasize : longint;
buf : array[0..511] of signedbyte;
bufsize : integer;
pb : ParamBlockRec;
tpb : transPB;
tproc : hdrHndl;
{* This procedure finds the desired TProc for the transliteration
* between the Mac and one of the other file systems and intializes it
*}
Procedure GetTProc;
var
tp : tprfHndl;
found : boolean;
entry : integer;
i : integer;
loCharSet,hiCharSet : integer;
theverb : integer;
theflag : integer;
err : OSErr;
begin
tproc := NIL;
{ One doesn't need a Tproc if the translation involves only one
computer type }
if statrec^^.trankind = tMCMC then exit(GetTProc);
{ get a handle to the Tproc family for the given source country,
if more than one trpf is available the user chooses which one to
use from the country menu provided by AFE. }
tp := POINTER(getResource('tprf',trnpb^.trncountry));
if tp = NIL then exit(GetTProc);
case statrec^^.tranKind of
tMCPD : begin
loCharSet := cfMacintosh;
hiCharSet := cfASCII;
theverb := transLotoHi;
theflag := trNonOnetoOne;
end;
tMCMS : begin
loCharSet := cfMacintosh;
hiCharSet := cfIBMPC;
theverb := transLotoHi;
theflag := trNonOnetoOne;
end;
end;
found := false;
{ Search through the whole tproc family for the one that translates
between the two character families }
for i := 1 to tp^^.lastentry do with tp^^.tprocs[i] do begin
if altcountry = trnpb^.trncountry then
if (curCharFam = loCharSet) and (altCharFam = hiCharSet) then begin
found := true;
entry := i;
leave;
end;
end;
if not found then exit(GetTProc);
{ Get a handle to the tproc specified by the tproc family entry }
tproc := POINTER(GetResource('tprc',tp^^.tprocs[entry].tprcID));
{ exit if the resource cannot be found }
if tproc = NIL then exit(GetTProc);
{ if not currently in memory thant load it now }
if tproc^ = NIL then loadResource(POINTER(tproc));
with tpb do begin
featureflags := band(tproc^^.flags,theflag);
newcntry := -1;
{ these fields are reserved set to zero }
tpRsrv[0] := 0;
tpRsrv[1] := 0;
tpRsrv[2] := 0;
tpRsrv[3] := 0;
{ initialize transliteration procedure }
verb := transInit;
err := CallTProc(tpb,tproc);
if err <> noerr then begin
tproc := NIL;
exit(GetTProc);
end;
{ the translations will be transLotoHigh }
verb := theverb;
end;
end;
{* This procedure send the source string to the Transliteration
* procedure and returns the result in tpb.dstText.trPtr. The verb for
* the translation was set in GetTProc.
* OUTPUT : Bufsize is changed to be the size of the destination
* buffer. It is used in WriteString.
*}
Procedure TranslitString(VAR str : str255);
var
err : OSErr;
begin
{ if there is no tproc than just move the source buffer to the
ioBuffer buffer }
if tProc = NIL then begin
blockmove(POINTER(ORD4(@str)+1),@buf,length(str));
bufsize := length(str);
end
else begin
tpb.srcText.trLen := length(str);
{ The first element of a string is its size, since we do not
want to translate this character we set the buffer to the
next one. }
tpb.srcText.trPtr := POINTER(ORD4(@str)+1);
tpb.srcText.trFont := 0;
tpb.dstText.trLen := 512;
tpb.dstText.trPtr := @buf;
tpb.dstText.trFont := 0;
{if the tproc is not in memory than load it }
if tproc^ = NIL then loadResource(POINTER(tproc));
err := CallTProc(tpb,tProc);
bufsize := tpb.dstText.trLen;
end;
end;
{* This procedure writes out a string to the destination file and adds
* a carriage return if cr is true. It assumes that the string is
* already pointed to by pb.ioBuffer using the assignment
* pb.ioBuffer := @Buf. It also assumes that GetTProc has already been
* called to get the required TProc.
*}
Procedure WriteString(str : str255; cr : boolean);
var
pct : integer;
err : OSErr;
begin
{ Use the tprocs to transliterate between character sets }
TranslitString(str);
pb.ioReqCount := bufsize;
err := FileIO(FFWrite,tofs,@pb,statrec,trnpb);
{ add the carriage return to the destination file }
if cr and (err = noerr) then begin
buf[0] := 13; {carriage return}
bufsize := 1;
{ if translating to an MSDOS disk a line feed is also needed to
start a new line. }
if statrec^^.tranKind = tMCMS then begin
buf[1] := 10; { line feed }
bufsize := 2;
end;
pb.ioReqCount := bufsize;
err := FileIO(FFWrite,tofs,@pb,statrec,trnpb);
end;
{ report any error that occurred while writing to the destination }
if err <> noerr then begin
reporterr(err,str_writing,statrec,trnpb);
CopyFile := err;
useResFile(oldres);
exit(copyFile)
end;
{ compute how much of the translation has been completed for
display in the status window }
datasize := datasize+length(str);
pct := datasize * 100 div statrec^^.srcSize;
if pct < 0 then pct := 0
else if pct > 100 then pct := 100;
{ if user clicks on cancel }
if not CallStat('',pct,1,trnpb^.trnStatProc) then begin
CopyFile := trnCancel;
useResFile(oldres);
exit(copyFile);
end;
end;
{* This procedure writes out the first line of the destination file
* it tells how many strings there are to translate }
Procedure Header(numstr : integer);
var
oldres : integer;
str : str255;
begin
datasize := 0;
GetTProc;
pb.ioCompletion := NIL;
pb.ioRefNum := dstref;
pb.ioBuffer := @buf;
pb.ioPosMode := fsAtMark;
oldres := CurResFile;
useResFile(statRec^^.myfref);
GetIndString(str,statrec^^.myID,str_numstrings);
WriteString(str,false);
{ convert the count of STR# resources to a string }
NumToString(numstr,str);
WriteString(str,true);
useResFile(oldres);
end;
{* This procedure writes to the destination file a line stating the
* string resource ID number
*}
Procedure HeaderString(s,theID,numentries : integer; theName : str255);
var
oldres : integer;
str : str255;
begin
oldres := CurResFile;
useResFile(statRec^^.myfref);
{ Insert a blank line }
WriteString('',true);
{ Write the string 'String Resource Number ' }
GetIndString(str,statrec^^.myID,str_stringRes);
WriteString(str,false);
{ convert the resource ID number to a string }
NumToString(theID,str);
WriteString(str,true);
{ make the old resource the current one }
useResFile(oldres);
end;
{* This procedure writes to the destination file one of the strings in
* a STR# resource. It is called from the main body of CopyFile
*}
Procedure EntryString(str : str255; n : integer);
var
oldres : integer;
str2 : str255;
begin
writeString(str,true);
end;
begin { Main body of CopyFile }
{ save the current resource file to restore later }
oldres := CurResFile;
useResFile(srcref);
{ get the number of STR# resources }
numstr := count1Resources('STR#');
{ Write the number of STR# resources to the destination file }
Header(numstr);
for s := 1 to numstr do begin
{ get the sth resource from the source file }
hstr := Get1IndResource('STR#',s);
if hstr = NIL then leave;
GetResInfo(hstr,theID,theType,theName);
{ make numptr point to the same place as the master pointer
of the STR# resource. Since numptr is of a different type we
use Pointer to avoid type conflicts. }
numptr := POINTER(hstr^);
{ The first value in a STR# resource is the number of strings in
the resource (an integer value). Since numptr is a ^integer, it
is pointing to this value }
numentries := numptr^;
Headerstring(s,theID,numentries,theName);
{ get each string in the resource and write it to the destination
file }
for n := 1 to numentries do begin
GetIndString(str,theID,n);
EntryString(str,n);
end;
end;
{ if we have been using a tproc tell it that we have finished the
translation }
if tproc <> NIL then begin
tpb.verb := transdone;
if tproc^ = NIL then loadresource(POINTER(tproc));
if CallTProc(tpb,tproc) <> noerr then ;
end;
useResFile(oldres);
CopyFile := noerr;
end; { CopyFile }
{******************************* DoAppear *******************************
* DoAppear is called in response to a trn_APPEAR message which occurs when *
* a new disk has been selected which has caused this routine to appear in *
* its menu. We do not change appearance in the menu, except to clear any *
* gray bits that may have been set. Returns NoErr as function result. *
* Some functions may use this procedureto define some global data *
* (such as source or destination FS, etc ). *
* Notice how the grey bit is turned off. First we create this bit value *
* with all the bits except for the grey bit on (-1 = $FFFFFFFF) Then we *
* bit and this with the current status, any high bits in the current *
* status remain high and none that are not are activated. This is called *
* masking, and is the most effecient method for changing individual status *
* bits. *
***************************************************************************}
Function DoAppear(trnpb : trnptr; statRec : statHndl) : longint;
begin
statRec^^.myStatus := band(statRec^^.myStatus,-1-trnGray);
DoAppear := noErr;
end; { DoAppear }
{********************************** DoFileConvert ***************************
* Called when the translator receives a trn_FILE. Result = Accept,unAccept, *
* or Cancel. *
* This function creates the necessary files for the translation to occur. *
* The actual translation is done by another function CopyFile. *
* Notice the care used in regards to duplicate file names, particularly the *
* creation of an intermediate file when copying in place (ie replacing the *
* source with the destination file).
****************************************************************************}
Function DoFileConvert(statRec : statHndl; trnPB : trnPtr) : longint;
var
err,err2 : OSErr;
srcopened,dstcreated,dstopened,tempfile : boolean;
pb : HParamBlockRec;
pbold,pbnew : WDPBRec;
catpb : CInfoPBRec;
srcref,dstref : integer;
frstr,tostr : str255;
str : str255;
begin
DoFileConvert := unaccept;
{ Note how we always use the same recognize for trn_File and trn_Recognize }
if RecogFile(statRec,trnPB) = accept then begin
DoFileConvert := accept;
srcopened := false;
dstcreated := false;
dstopened := false;
tempfile := false;
tostr := trnPB^.trnnames^^.names[1]; { source file name }
frstr := trnPB^.trnnames^^.names[0]; { destination file name }
err := noerr;
{ create the destination file }
if err = noerr then with pb do begin
ioNamePtr := @tostr;
pb.ioFVersNum := 0;
err := FileOp(FFCreate,toFS,@pb,statrec,trnpb);
{ if the file already exists }
if err = dupfNErr then begin
{ check to see if it is the source file }
if (trnpb^.trnfrID = trnpb^.trntoID)
and (trnpb^.trnfrVRef = trnpb^.trntoVRef)
and (trnpb^.trnfrpar = trnpb^.trntopar)
and (tostr = frstr) then begin
{ if it is then create a temporary file to hold the tran-
slation }
tostr := '$$$@FE-TEMP$$$';
repeat
{ increment the fourth letter by one until we get }
{ a unique name for the temporary file }
tostr[4] := CHR(ORD(tostr[4])+1);
err := FileOp(FFCreate,toFS,@pb,statrec,trnpb);
until err <> dupfNErr;
{ if another error occurred then do not translate }
if err <> noerr then err := fBsyErr
else tempfile := true;
end
{ if the destination is not the same as the source then delete
the current file and create a new destination file }
else begin
ioNamePtr := @tostr;
ioFVersNum := 0;
err2 := FileOp(FFDelete,toFS,@pb,statrec,trnpb);
if err2 = noerr then begin
ioNamePtr := @tostr;
pb.ioFVersNum := 0;
err := FileOp(FFCreate,toFS,@pb,statrec,trnpb);
end;
end;
end;
{ if the last operation was successful then the destination file
was created }
if err = noerr
then dstcreated := true
else reportErr(err,str_creating,statRec,trnPB);
end;
{ if a Mac to Mac translation }
if statRec^^.trankind = tMCMC then begin
{* Note: before doing a SetFInfo it is a good idea make sure that there is *
* valid information in all param block fields so do a GetFInfo first *}
if err = noerr then with catpb do begin
ioNamePtr := @tostr;
ioFDirIndex := 0;
err := FileOp(FFGetFInfo,toFS,@catpb,statrec,trnpb);
{ If the destination gives a bad param block try the source }
if err <> noerr then begin
ioNamePtr := @frStr;
ioFVersNum := 0;
err := FileOp(FFGetFInfo,fromFS,@catpb,statrec,trnpb);
err := noerr;
end;
end;
{ Set the destination file type and creator }
if err = noerr then with catpb do begin
ioNamePtr := @tostr;
ioflFndrInfo.fdtype := 'TEXT';
ioflFndrInfo.fdcreator := statrec^^.ftype;
err := FileOp(FFSetFInfo,toFS,@catpb,statrec,trnpb);
if err <> noerr then reportErr(err,str_setfinfo,statRec,trnPB);
err := noerr;
end;
end;
{ For all file systems open the destination }
if err = noerr then with pb do begin
ioNamePtr := @tostr;
if statrec^^.tranKind = tMCPD
then ioPermssn := 0
else ioPermssn := fsWrPerm;
ioMisc := NIL;
err := FileOp(FFOpen,toFS,@pb,statrec,trnpb);
if err = noerr then begin
dstopened := true;
dstref := ioRefNum;
end
else reportErr(err,str_opendst,statRec,trnPB);
end;
{ check to see if the file is already opened }
if err = noerr then with catpb do begin
ioNamePtr := @frstr;
ioFVersNum := 0;
ioFDirIndex := 0;
err := FileOp(FFGetFInfo,fromFS,@catpb,statrec,trnpb);
if err <> noerr then reportErr(err,str_getfinfo,statRec,trnPB);
end;
if (err = noerr) and (band(catpb.ioFlAttrib,$04) = 0) then with pb do begin
pbold.ioCompletion := NIL;
pbold.ioNamePtr := NIL;
err := PBHGetVol(@pbold,false);
if err = noerr then with pbnew do begin
ioCompletion := NIL;
ioNamePtr := NIL;
ioVRefNum := trnpb^.trnfrvref;
ioWDDirID := trnpb^.trnfrpar;
err := PBHSetVol(@pbnew,false);
end;
if err = noerr then begin
srcref := OpenResFile(trnpb^.trnNames^^.names[0]);
err := PBHSetVol(@pbold,false);
end;
{ if the resource fork of the source could not be opened then exit }
if (err = noerr) and (srcref <= 0) then err := fnferr;
if err = noerr then begin
srcopened := true;
end
else reportErr(err,str_opendst,statRec,trnPB);
end
else if err = noerr then srcRef := catpb.ioFRefNum;
{ If opened destination get size of source strings, this value is saved in
statrec^^.srcsize after opening the source file *}
if err = noerr then with catpb do begin
statrec^^.srcsize := GetStrSize(srcref);
end;
{ If no errors so far then translate the file }
GetIndString(str,statrec^^.myID,str_copying);
if not CallStat(str,0,1,trnpb^.trnStatProc) then err := trnCancel;
if err = noerr then err := copyFile(srcref,dstref,statrec,trnpb);
if not CallStat('',100,1,trnpb^.trnStatProc) then err := trnCancel;
{ Close the files and erase any temporary files }
if srcopened then with pb do begin
CloseResFile(srcref);
end;
if dstopened then with pb do begin
ioRefNum := dstref;
err2 := FileIO(FFClose,tofs,@pb,statrec,trnpb);
end;
{ If an error occurred during translation than delete the destination
file, it is not valid }
if (err <> noerr) and dstcreated then with pb do begin
ioNamePtr := @tostr;
ioFVersNum := 0;
err2 := FileOp(FFDelete,toFS,@pb,statrec,trnpb);
end;
{ if a translation in place was completed then delete the source and
rename the destination with the source name }
if (err = noerr) and tempfile then with pb do begin
ioNamePtr := @frstr;
ioFVersNum := 0;
err2 := FileOp(FFDelete,toFS,@pb,statrec,trnpb);
if err2 <> noerr then reportErr(err2,str_delsrc,statRec,trnPB);
if err2 = noerr then begin
ioNamePtr := @tostr;
ioFVersNum := 0;
ioMisc := @frstr;
err2 := FileOp(FFRename,toFS,@pb,statrec,trnpb);
if err2 <> noerr then reportErr(err2,str_rendst,statRec,trnPB);
end;
end;
if err = trncancel then DoFileConvert := trnCancel;
end;
end; { DoFileConvert }
{************************************** DoFinish ****************************
* Called when transltor receives an trn_FINIS. *
* DoFinish cleans up any global variables that might have been allocated. *
* ALWAYS returns NoErr. It is only called when execution of AFE is *
* terminated (ie. you hit quit ). *
***************************************************************************}
Function DoFinish(VAR translateData : handle) : OSErr;
begin
DoFinish := noErr;
if translateData <> NIL then disposHandle(translateData);
translateData := NIL;
end;
{************************************** DoInit ******************************
* Called whenever a translator receives a trn_INIT message. This happens *
* when translators are imported to other menus as well as at startup. *
* DoInit initializes the variables we need. It allocates a relocatable *
* block of memory and puts the handle in translateData. It determines the *
* source and dest file system and sets up the default parameters. It *
* returns noErr if all goes well, and a negative result otherwise. *
***************************************************************************}
Function DoInit(VAR translateData,self : handle; trnpb : trnPtr) : longint;
var
theID : integer; theType : restype; namefr,nameto,myname : str255;
str : str255;
dstnick,srcnick : halfResType;
err : OSErr;
statRec : StatHndl;
kind : integer;
srcHandle,dstHandle : handle;
len : integer;
thefref : integer;
begin
{* get handles of source and dest file systems
* Note: GetResource returns NoErr even if it does not find the
* resource. This is why one must check for NIL handles as well as
* ResError.}
srcHandle := GetResource(foreignFS,trnpb^.trnfrID);
err := ResError;
if (err = noErr) and (srcHandle = NIL) then err := resNotFound;
if err = noerr then begin
dstHandle := GetResource(foreignFS,trnpb^.trntoID);
err := ResError;
if (err = noErr) and (dstHandle = NIL) then err := resNotFound;
end;
{* get nickname of source file system = The last two characters of
* the file system name; MC, MS, PD. }
if err = noerr then begin
GetResInfo (srcHandle, theID, theType, namefr);
err := ResError;
end;
if err = noErr then begin
len := length(namefr);
if len <= 2 then err := bdNamErr;
end;
if err = noErr then begin
srcnick[1] := namefr[len-1]; srcnick[2] := namefr[len];
if (srcnick <> 'PD') and (srcnick <> 'MS') and (srcnick <> 'MC')
then err := extFSErr;
end;
{* get nickname of destination file system *}
if err = noerr then begin
GetResInfo (dstHandle, theID, theType, nameto);
err := ResError;
end;
if err = noErr then begin
len := length(nameto);
if len <= 2 then err := bdNamErr;
end;
if err = noErr then begin
dstnick[1] := nameto[len-1]; dstnick[2] := nameto[len];
if (dstnick <> 'PD') and (dstnick <> 'MS') and (dstnick <> 'MC')
then err := extFSErr;
end;
{* get information about translator. Keeping the file reference number
* allows one to switch the resource file in use to one's own if it is
* not the current one.
*}
if err = noerr then begin
getResInfo(self,theID,thetype,myname);
err := ResError;
end;
if err = noerr then begin
theFRef := homeResFIle(self);
err := ResError;
end;
{* determine kind of translation. This translator only supports tran-
* slation from the Macintosh file system. If we are not in one of these
* menus then generate an error.
*}
if err = noErr then begin
if (srcnick='MC') and (dstnick = 'MC') then kind := tMCMC
else if (srcnick='MC') and (dstnick = 'PD') then kind := tMCPD
else if (srcnick='MC') and (dstnick = 'MS') then kind := tMCMS
else err := extFSerr;
end;
{* get global data space. Why do we make statrec a pointer to handle can
you even do this?!? *}
if err = noErr then begin
translateData := NewHandle(sizeof(statusRec));
statrec := POINTER(translateData);
err := MemError;
end;
{* set up default settings *}
if err = noErr then with statRec^^ do begin
{ Check menu item (make it active) and set the About bit }
myStatus := trnActive + trnAbout;
{ the ID number of the translator resource }
myID := theID;
{ the file reference number of the translator file }
myFref := theFref;
{ the type of translation (Mac to Mac, etc.) }
trankind := kind;
{ default file type is MacWrite }
ftype := 'MACA';
{ default translation is into a MacWrite file }
fkind := tMacWrite;
{ Handles to the source and destination file system (resources). }
frHandle := srcHandle;
toHandle := dstHandle;
end;
if err <> noerr then begin
GetIndString(str,theID,str_error);
CallErrLog(str,false,false,trnpb^.trnlogproc);
GetIndString(str,theID,str_initing);
CallLog(str,false,false,trnPB^.trnlogproc);
CallLog(myname,false,false,trnPB^.trnlogproc);
GetIndString(str,theID,str_period);
CallLog(str,true,false,trnPB^.trnlogproc);
{ If translator is not in a valid menu }
if err = extFSerr then begin
GetIndString(str,theID,str_cant);
CallLog(str,false,false,trnPB^.trnlogproc);
CallLog(copy(namefr,1,length(namefr)-2),false,false,trnPB^.trnlogproc);
GetIndString(str,theID,str_to);
CallLog(str,false,false,trnPB^.trnlogproc);
CallLog(copy(nameto,1,length(nameto)-2),false,false,trnPB^.trnlogproc);
GetIndString(str,theID,str_period);
CallLog(str,true,false,trnPB^.trnlogproc);
end;
end;
DoInit := err;
end; { DoInit }
{******************************* DoName ********************************
* Called when the translator receives a trn_NEWNAME message *
* trn_NEWNAME is passed a trnPTR in PARAM. It should check the file *
* specified as the source and return either NOERR or UNACCEPT as the *
* function result, depending on whether the file matches the criteria for *
* acceptance by this routine (it can skip checking for acceptance if the *
* trnTESTED field is true -- in that case, the trnACCEPTED field indicates *
* whether this file was previously accepted). If acceptable, then *
* trn_NEWNAME should return a suggested new name for the destination file, *
* and set the field trnNAMES.NAMECNT to 1. On those occasions when more *
* than one destination file will be produced, the name handle should be *
* expanded and trnNAMES.NAMECNT should be increased appropriately. *
***************************************************************************}
Function DoName(statRec : statHndl; trnPB : trnPtr) : longint;
var
temp : longint;
pb : HParamBlockRec;
err : OSErr;
str : str255;
begin
DoName := unaccept;
if RecogFile(statRec,trnPB) = accept then begin
str := trnpb^.trnNames^^.names[0];
trnpb^.trnNames^^.NameCnt := 1;
pb.ioNamePtr := @str;
pb.ioDirID := trnpb^.trnToPar;
pb.ioVRefNum := trnPb^.trnToVRef;
err := FileOp(FFMakeFName,toFS,@pb,statrec,trnpb);
if err = noerr then begin
trnpb^.trnNames^^.names[1] := str;
DoName := accept;
end;
end;
end; { DoName }
{******************************** FileIO *********************************
* Called by CopyFile, DoFileConvert *
* This is a utility function that does the repetitive actions for *
* FFREAD, FFWRITE, and FFCLOSE. The Calling procedure provides: *
* ioRefNum *
* ioposMode†, ioposOffset† *
* ioReqCount†, ioBuffer † *
* *
* † for READ and WRITE only *
* *
***************************************************************************}
Function FileIO(ff,fs : integer; pb : HParmBlkPtr; statrec : StatHndl;
trnPB : trnPtr) : OSErr;
var
err : OSErr;
begin
pb^.ioCompletion := NIL;
err := noErr;
if fs = fromFS
then err := CallFS(ff,trnpb^.trnfrData,POINTER(pb),false,statrec^^.frHandle)
else err := CallFS(ff,trnpb^.trntoData,POINTER(pb),false,statrec^^.toHandle);
FileIO := err;
end; { FileIO }
{******************************** FileOp *********************************
* Called by DoFileConvert, DoFileName, RecogFile *
* for FFOPEN, FFGETFINFO, FFGETCATINFO, FFSETCATINFO, FFSETFINFO, FFRENAME,*
* FFDELETE, FFCREATE, FFGETXCATINFO, FFSETXCATINFO, FFMAKEFNAME *
* Calling procedure provides (in the pb variable): *
* ioMisc,ioPermssn,ioNamePtr -- FFOPEN *
* This function provides the part of the CallFS function that does not *
* change for the calls listed above. It eliminates having to repeat it for *
* every one of the calls. *
***************************************************************************}
Function FileOp(ff,fs : integer; pb : HParmBlkPtr; statrec : StatHndl; trnPB : trnPtr) : OSErr;
{ ff = file system command, fs = source or destination file }
var
err : OSErr;
begin
with pb^ do begin
ioCompletion := NIL;
if fs = fromFS then begin
ioVRefNum := trnpb^.trnfrVRef;
ioDirID := trnpb^.trnfrPar;
err := CallFS(ff,trnpb^.trnfrData,POINTER(pb),false,statrec^^.frHandle);
end
else begin { perfrom operation on the source file }
ioVRefNum := trnpb^.trntoVRef;
ioDirID := trnpb^.trntoPar;
err := CallFS(ff,trnpb^.trntoData,POINTER(pb),false,statrec^^.toHandle);
end;
end;
FileOp := err;
end; { FileOp }
Function GetStrSize(fref : integer) : longint;
var
oldres : integer;
size : longint;
h : handle;
numstr,s : integer;
begin
oldres := curResFile;
useResFile(fref);
setResload(false);
numstr := count1Resources('STR#');
size := 0;
for s := 1 to numstr do begin
h := Get1IndResource('STR#',s);
size := size + MaxSizeRsrc(h);
end;
setResLoad(true);
useResFile(oldres);
GetStrSize := size;
end;
{******************************** RecogFile *********************************
* Called when trasnlator receives trn_Recognize. *
* It is also called by DoName and DoFileConvert. *
* RecogFile is passed a trnPTR and status record. It should check the file*
* specified as the source and return either ACCEPT or UNACCEPT as the *
* function result, depending on whether the file matches the criteria for *
* acceptance by this routine. Notice how we do not log errors during that *
* may occur in this function. We only want to know if this translator can *
* translate this file or not, if it can't for any reason then we do not *
* accept the file. *
***************************************************************************}
Function RecogFile(statRec : statHndl; trnPB : trnPtr) : longint;
var
err : OSErr;
pb : HParamBlockRec;
pbnew,pbold : WDPBRec;
temp : OSType;
size,readsize : longint;
fref, num : integer;
srcopened : boolean;
oldres : integer;
begin
{* check if the file's already been tested *}
RecogFile := unaccept;
if trnPB^.trnTested then begin
if trnPB^.trnAccepted then RecogFile := accept;
exit(RecogFile);
end;
{* check whether we have a resource fork or no *}
pb.ioNamePtr := @trnpb^.trnNames^^.names[0];
pb.ioFDirIndex := 0;
err := FileOp(FFGetFInfo,fromFS,@pb,statrec,trnpb);
if err <> noerr then exit(RecogFile); { don't log errors during recognition }
if pb.ioFlRPyLen = 0 then exit(RecogFile);
srcopened := false;
if band(pb.ioFlAttrib,$04) = 0 then begin { if already opened, don't reopen }
{* now we have to check things out via the resource manager *}
{* first: set up the volume because the resource manager doesn't allow volume
AND directory specification *}
pbold.ioCompletion := NIL;
pbold.ioNamePtr := NIL;
err := PBHGetVol(@pbold,false);
if err <> noerr then exit(RecogFile);
with pbnew do begin
ioCompletion := NIL;
ioNamePtr := NIL;
ioVRefNum := trnpb^.trnfrvref;
ioWDDirID := trnpb^.trnfrpar;
err := PBHSetVol(@pbnew,false);
if err <> noerr then exit(RecogFile);
end;
fref := OpenResFile(trnpb^.trnNames^^.names[0]);
err := PBHSetVol(@pbold,false);
{ if the resource fork of the source could not be opened then exit }
if fref <= 0 then exit(RecogFile);
srcopened := true;
end
else fref := pb.ioFRefNum;
oldres := CurResFile;
useResFile(fref);
num := count1Resources('STR#');
useResFile(oldres);
if num > 0
then RecogFile := accept;
if srcopened then begin
CloseResFile(fref);
end;
end; { RecogFile }
{******************************** ReportErr *********************************
* Called whenever an error occurs that must be reported to the user log, ie *
* it is used by almost all of the procedures. *
* Notice how part of the error message is reported using resources stored *
* in the AFE resource fork (for err <0 and >-85). AFE includes some stan- *
* dard strings for these errors, check them out with ResEdit to see if they *
* fit in your error messages as well. They are in the STR# ID=150 resource * *
****************************************************************************}
Procedure ReportErr(err,doing : integer; statRec : statHndl; trnPB : trnPtr);
{ err = error code (usually a File manager code,
doing = the action attempted that caused the error, one of the str_
constants declared at the top of this unit }
var
Str : str255;
oldres : integer;
begin
{ save the AFE file ref number of the AFE resource file }
oldres := curResFile;
{ use the translator resource file }
useResFile(statRec^^.myFRef);
GetIndString(str,statrec^^.myID,str_error);
CallErrLog(str,false,true,trnPB^.trnlogproc);
GetIndString(str,statrec^^.myID,doing);
CallErrLog(str,false,true,trnPB^.trnlogproc);
useResFile(oldres);
{ if appropriate use the error string from the AFE resource STR#150 }
if (err < 0) and (err > -85)
then GetIndString(str,150,-err)
else GetIndString(str,150,5);
CallErrLog(str,true,true,trnpb^.trnlogproc);
end; { ReportErrLog }
{********************************* TranStr **********************************
* This is the function that provides the interaction between AFE and the *
* translator. It ALWAYS has the SAME number and types of parameters. *
* INPUT : Message - this integer describes the opertation requested by *
* AFE for a complete listing of these operations see the *
* constants under the "Conversion Routine Commands" heading *
* TranslateData - this is either the default settings for this *
* translator, or a handle to some global data the translator *
* has allocated. *
* Param - Varies with the message. Usually a pointer to info on *
* source and destination files, or names of translated files. *
* Self - this is a handle to the translation routine itself. *
* It is used to lock the routine in memory while it is in use.*
* OUTPUT : NONE *
* RESULT : Varies with the message. Usually the status of a certain oper*
* ation. If AFE does not explicitly require a result the tran-*
* slator must return a zero. *
****************************************************************************}
function TranStr(Message : integer; VAR translateData : Handle;
Param : longint; Self : handle) : longint;
var
trnpb : trnPtr;
statRec,statrec2 : statHndl;
oldres : integer;
h : handle;
err : OSErr;
begin
hlock(self);
trnpb := POINTER(Param);
statRec := POINTER(translateData);
case Message of
trn_Init : begin
TranStr := DoInit(translateData,self,trnpb);
end;
trn_Finis : begin
TranStr := DoFinish(translateData);
end;
trn_Appear : begin
TranStr := DoAppear(trnpb,statRec);
end;
trn_Disappear : begin
{* trn_DISAPPEAR cleans up any global variables that might have
* been allocated by trn_APPEAR. ALWAYS returns NoErr.
*}
TranStr := noerr;
end;
trn_Get : begin
{* trn_GET returns the current status of this routine as the
* function result.
*}
TranStr := statRec^^.myStatus;
end;
trn_Set : begin
{* trn_SET sets the status flag of this routine using the
* value in PARAM. The new status flag is returned as the
* function result.
*}
statRec^^.myStatus := param;
TranStr := param;
end;
trn_Active : begin
TranStr := Activate(statRec,trnPB);
end;
trn_Inactive : begin
{* trn_INACTIVE indicates that the user wishes to UNcheck this
* menu item. The routine just clears the active bit in the
* flags, and then returns the new status flag as the
* function result.
*}
statRec^^.myStatus := band(statRec^^.myStatus,-1-trnActive);
TranStr := statRec^^.myStatus;
end;
trn_Recognize : begin
TranStr := RecogFile(statRec,trnpb);
end;
trn_NewName : begin
TranStr := DoName(statRec,trnpb);
end;
trn_File : begin
{* trn_FILE is passed a trnPTR in PARAM. It should check
* the file specified as the source and return either NOERR
* or UNACCEPT as the function result, depending on whether
* the file matches the criteria for acceptance by this
* routine. If acceptable, then trn_FILE should do the actual
* translations, using the name (or possibly names) specified
* in the name handle. Any errors encountered during translations
* should be reported to the user log. Periodically, the
* status procedure should be called with a (possibly empty)
* status message and a number between 0 and 100 indicating
* the percentage complete. This routine will return TRUE
* most of the time, but can return FALSE if the user has
* pressed the CANCEL button on the status panel. Because the
* user can press CANCEL, it is requested that trn_FILE call
* the status procedure as often as necessary to achieve some
* measure of reasonable feedback.
*}
TranStr := DoFileConvert(statRec,trnpb);
end;
trn_Load : begin
{*
* Do a GETRESOURCE for all of the resources that you might
* need during a translation. This does not guarantee that
* a "floppy shuffle" won't be needed, just helps the odds.
* Load the most likely to be used resources last so they will
* be the least likely to be purged.
*}
oldres := curResFile;
useResFile(statrec^^.myFRef);
h := getResource('ICON',statrec^^.myID);
h := getResource('ICON',statrec^^.myID+1);
h := getResource('ICON',statrec^^.myID+2);
h := getResource('ICON',statrec^^.myID+3);
h := getResource('DITL',statrec^^.myID);
h := getResource('DLOG',statrec^^.myID);
h := getResource('STR#',statrec^^.myID);
useResFile(oldres);
{ don't bother bringing in the ABOUT text }
TranStr := 0;
end;
trn_About : begin
{*
* If we want to tell the user about ourselves, we can put up
* our own dialog (in which case we return zero). If we want
* nothing done, we can return -1, whereupon Apple File Exch will
* inform the user that no information is available.
* If we want Apple File Exch to display the information, we can give
* it a (positive) resource ID of a TEXT resource containing
* information about us.
*}
TranStr := statrec^^.myID;
end;
trn_GetSettings : begin
{*
* With this message, Apple File Exch is requesting a handle filled
* with data that can be stored in a document. Apple File
* Exchange allows the user to save and restore default settings
* ("preferences", if you will) so that the user can launch
* the program and have each translation be in a state that
* they are familiar with. We have to do the NEWHANDLE call
* to create a handle of the correct size, Apple File Exch will
* dispose it later. If this call is not supported, return
* NIL or some (negative) error code.
*}
h := translateData;
{ Create a new handle that points to a COPY of the global data }
err := HandToHand(h); { see Inside Mac vol II, p374 for details }
if err = noerr
then TranStr := ORD4(h)
else TranStr := err;
end;
trn_SetSettings : begin
{*
* With this message, Apple File Exch is passing a handle filled
* with data that indicates a default setting. Apple File Exchange
* allows the user to save and restore default settings
* ("preferences", if you will) so that the user can launch
* the program and have each translation be in a state that
* they are familiar with. Apple File Exch will dispose of this
* handle later (do not do so yourself). If this call is
* not supported, return NIL or some (negative) error code.
*}
h := POINTER(param);
{ If for some reason AFE does not send a pointer to the correct
data then do not change the current set up }
if GetHandleSize(h) <> sizeof(statusRec) then TranStr := 0
else with statrec^^ do begin
statrec2 := POINTER(h);
mystatus := statrec2^^.mystatus;
ftype := statrec2^^.ftype;
fkind := statrec2^^.fkind;
end;
end;
end;
hunlock(self);
hpurge(self);
end;
end.
